Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/appshell/appmain.frm

Text File | 1995-09-06 | 9KB | 404 lines

VERSION 2.00
Begin Form AppMain
   Caption         =   "App Shell - [untitled]"
   ClientHeight    =   5370
   ClientLeft      =   885
   ClientTop       =   1485
   ClientWidth     =   8205
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   6060
   Icon            =   APPMAIN.FRX:0000
   Left            =   825
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   5370
   ScaleWidth      =   8205
   Top             =   855
   Width           =   8325
   Begin TextBox AppText
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Courier"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   5415
      Left            =   -45
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   -45
      Width           =   8250
   End
   Begin Menu FileMenu
      Caption         =   "&File"
      Begin Menu FileNewCmd
         Caption         =   "&New"
      End
      Begin Menu FileOpenCmd
         Caption         =   "&Open..."
      End
      Begin Menu FileSaveCmd
         Caption         =   "&Save"
      End
      Begin Menu FileSaveAsCmd
         Caption         =   "Save &As..."
      End
      Begin Menu FileSep1
         Caption         =   "-"
      End
      Begin Menu FilePrintCmd
         Caption         =   "&Print..."
      End
      Begin Menu FilePrinterSetupCmd
         Caption         =   "P&rinter Setup..."
      End
      Begin Menu FileSep2
         Caption         =   "-"
      End
      Begin Menu FileExitCmd
         Caption         =   "E&xit"
      End
   End
   Begin Menu HelpMenu
      Caption         =   "&Help"
      Begin Menu UsingHelpCmd
         Caption         =   "Using Help"
      End
      Begin Menu HelpSep2
         Caption         =   "-"
      End
      Begin Menu HelpAboutCmd
         Caption         =   "&About"
      End
   End
End
' ================
' Copyrights & CYA
' ================
'
' App Shell is freeware with the following intent:
'
' -  You are free to incorporate App Shell into your code that will be
'    distributed in executable form.
' -  You are free to distribute App Shell source or incorporate App Shell
'    source into your source code assuming no charge is required and this
'    copyright is maintained and acknowledged.
' -  You are free to distribute App Shell source as shareware assuming
'    you are an approved vendor and associate member of the Association
'    of Shareware Professionals (ASP).  No registration fee is required
'    but this copyright must be maintained and acknowledged.
' -  All other distribution rights are maintained by the author.
' -  The author makes NO warranties, express or implied, oral or written,
'    including any implied warranties of merchantability or fitness for
'    a particular purpose.  In no event shall the author be liable for
'    any damages whatsoever arising out of the use of the software.
'
' If you find any bugs, anomalies, or have any questions or suggestions,
' please send them to Jim Presley (CIS ID - 73417,2674).  Enjoy!
'
'

Sub AppText_Change ()

  App_Changed = True
  App_Data = AppText.Text

End Sub

Function CheckForChange () As Integer

  x% = 0

  If App_Changed Then
    If App_FileName = "" Then
      a$ = "[Untitled]"
    Else
      a$ = UCase$(App_FileName)
    End If
    x% = MsgBox(a$ + " has changed.  Save current changes?", MB_YESNOCANCEL + MB_ICONEXCLAMATION, APP_NAME)
    If x% = IDYES Then
      x% = SaveFile(False)
    End If
  End If

  CheckForChange = x%

End Function

Sub ExitProcessing ()
  '
  If CheckForChange() <> IDCANCEL Then End
End Sub


Sub FileExitCmd_Click ()
  ExitProcessing
End Sub

Sub FileNewCmd_Click ()
  If CheckForChange() <> IDCANCEL Then
    LoadFileNew
    LoadMainControls
    App_Changed = False
  End If
End Sub

Sub FileOpenCmd_Click ()
  If CheckForChange() <> IDCANCEL Then
    App_OpenTitle = "Open File"
    App_OpenSaveStyle = APP_OPEN

    AppOpenSave.Show Modal
    Unload AppOpenSave

    If App_DialogReturn = IDOK Then
      '
      ' load the file
      '
      If LoadFile() Then
        LoadMainControls
        App_Changed = False
      End If
    End If
  End If
End Sub

Sub FilePrintCmd_Click ()

  Dim Win_PrinterName As String
  Dim Win_PrinterDriver As String
  Dim Win_PrinterPort As String
  Dim RestorePrinter As Integer

  '
  ' get the print parameters
  '
  AppPrint.Show Modal

  GetDefaultPrinter Win_PrinterName, Win_PrinterDriver, Win_PrinterPort

  '
  ' print the document
  '
  RestorePrinter = False
  If App_PrinterName <> Win_PrinterName Then
    '
    ' make the printer the default
    '
    WriteDefaultPrinter App_PrinterName, App_PrinterDriver, App_PrinterPort
    RestorePrinter = True
  End If

  For App_PrintCopyNumber = 1 To App_PrintCopies
    AppPrinting.Show Modal
    If App_PrintCancel Then Exit For
  Next

  If RestorePrinter Then
    '
    ' restore the default windows printer
    '
    WriteDefaultPrinter Win_PrinterName, Win_PrinterDriver, Win_PrinterPort
  End If

End Sub

Sub FilePrinterSetupCmd_Click ()

  AppPrSetup.Show Modal

End Sub

Sub FileSaveAsCmd_Click ()

  '
  ' save the file and load main form's caption
  '
  If SaveFile(True) Then LoadMainTitle

End Sub

Sub FileSaveCmd_Click ()

    x% = SaveFile(False)

End Sub

Sub Form_Load ()
  '
  ' load any file specified on the command line into memory
  '
  c$ = Command$
  If c$ <> "" Then
    If InStr(c$, ".") = 0 Then c$ = c$ + App_FileExtension
    a$ = Dir$(c$)
    If a$ = "" Then
      MsgBox "File name " + UCase$(c$) + " entered on command line not valid.", MB_ICONEXCLAMATION, APP_NAME
      LoadFileNew
    Else
      App_FullFileName = c$
      SplitFileName App_FullFileName, App_Path, App_FileName
      If Not LoadFile() Then
        LoadFileNew
      End If
    End If
  Else
    LoadFileNew
  End If

  LoadMainControls
  App_Changed = False

End Sub

Sub Form_Resize ()

  AppText.Move 0, 0, ScaleWidth, ScaleHeight

End Sub

Sub Form_Unload (Cancel As Integer)
  ExitProcessing
  '
  ' if processing returns that means the user cancelled
  ' the termination
  '
  Cancel = True

End Sub

Sub HelpAboutCmd_Click ()
  AppAbout.Show Modal
End Sub

Function LoadFile () As Integer

  '
  ' Load the file
  '
  LoadFile = True
  Screen.MousePointer = HOURGLASS

  On Error GoTo LoadFileError

  FileNum% = FreeFile
  Open App_FullFileName For Input As FileNum%

  If LOF(FileNum%) > 60000 Then
    MsgBox "Sorry, file too large", MB_STOPICON, APP_NAME
    LoadFile = False
    Exit Function
  End If

  Do Until EOF(FileNum%)
    Line Input #FileNum%, nl$
    a$ = a$ + nl$ + CRLF
  Loop

  Close FileNum%

  App_Data = a$
  Screen.MousePointer = DEFAULT

  On Error GoTo 0
  Exit Function

LoadFileError:

  a$ = Error$(Err)
  MsgBox "Error: " + a$, MB_ICONSTOP, APP_NAME
  LoadFile = False
  On Error GoTo 0
  Screen.MousePointer = DEFAULT
  Exit Function

End Function

Sub LoadFileNew ()
  '
  App_FileName = ""
  App_Path = CurDir$
  App_Data = ""

End Sub


Sub LoadMainControls ()

  LoadMainTitle

  AppText.Text = App_Data

End Sub


Sub LoadMainTitle ()

  If App_FileName <> "" Then
    AppMain.Caption = APP_NAME + " - " + UCase$(App_FileName)
  Else
    AppMain.Caption = APP_NAME + " - [Untitled]"
  End If

End Sub

Function SaveFile (NewName As Integer) As Integer

  '
  ' get a file name if untitled
  '
  If App_FileName = "" Or NewName Then
    App_SaveTitle = "Save File As"
    App_OpenSaveStyle =